perm filename RESPC.F4[PAG,LCS]2 blob
sn#365847 filedate 1978-07-01 generic text, type T, neo UTF8
00100 SUBROUTINE RESPC
00200 COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
00300 1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
00400 1 RCLEF(0/7) /IVV/IV(1)
00500 COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
00600 C ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
00700 COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
00800 1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
00900 C INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
01000 DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
01100 1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
01200 INTEGER DUMMY
01300 COMMON /PX/PN(1) /Q/Q(1)
01400 1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
01500 1 /KBAR/KBAR(1) /RSP/KNM(20),ENDLN,KQ,NAME,NMPG,SPCNT
01600 DATA FIB/.8/ ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
01700 1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/
01800 C RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.
01900 EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
02000 1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
02100 1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
02200 1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
02300 1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
02400 1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
02500 C RQ(2) IS R4, RQ(3) IS R5 ETC.
02600 CC DATA JXYZ/1/
02700
02800 IF(NMPG.NE.'PAGEA')GO TO 2000
02900 CC NPZ='PAGEZ'
03000 CC NPZF='PAGFZ'
03100 CC NPZG='PAGGZ'
03200 C SHOULD HANDLE UP TO 104 INPUT FILES. ADD HERE AND LATER FOR MORE RANGE.
03300 RNEXT=0
03400 2000 SPCNT=1.0
03500 CC DO 2001 K=1,JXYZ
03600 CC2001 RN(K)=0
03700 C MUST ZERO NN AND MM ARRAYS, ETC.
03800 JX=0
03900 JCEN=0
04000 C FLAG FOR CENTERED RESTS.
04100 XT=0
04200 PX=0
04300 CALL SHFT1(KQ)
04400 KK=L
04500 CC TYPE 3001,L
04600 C DELETES EXTRA BAR LINES, ETC.
04700 IF(IPG)CALL RESTS
04800 C??? IF(N)RETURN
04900 C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
05000 C FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
05100 CALL SHIFT
05200 C L=NUMBER OF ITEMS FOR RHY RECONS.
05300 JJ2=L+2
05400 C FOR WDCNT IN .PAG FILE
05500 N=0
05600 S=-100
05700 R=0
05800 KCLEF=0
05900 NOGRCE=-1
06000 C GRACE NOTE FLAG
06100 TTT=0
06200 C FOR IRREG. NUMS. OF STAVES.
06300
06400 DO 601 K=1,L
06500 R=CODEN(KPN,K,Q,J)
06600 RZ=Q(J)
06700 CX J=KPN(K)
06800 CC N=N+1
06900 CC NN(N)=0
07000 CC MM(N)=J+3
07100 CALL MMNN(3)
07200 CX R=Q(J+1)
07300 IF(R.GT.2)GO TO 1801
07400 IF(Q(J+2).GT.TTT)TTT=Q(J+2)
07500 C FINDS HIGHEST STAFF NUM. NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
07600 IF(R.NE.1)GO TO 2801
07700 IF(RZ.LT.7)GO TO 601
07800 IF(Q(J+9).GT..05)GO TO 702
07900 IF(Q(J+9).EQ.0)GO TO 601
08000 CC IF(Q(J+8).EQ.1000)GO TO 601
08100 C SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
08200 NOGRCE=0
08300 GO TO 601
08400 CCC2801 IF(R.NE.2)GO TO 1801
08500 2801 IF(RZ.NE.7)GO TO 3801
08600 C DELETE ALL UP TO LABEL 1801 LATER. NEW CENTERED REST FEATURE. 5/29/78
08700 NN(N)=R
08800 GO TO 688
08900 3801 IF(RZ.LT.5)GO TO 601
09000 IF(IPG)GO TO 1801
09100 IF(RZ.LT.6)GO TO 1801
09200 RS=Q(J+3)
09300 C GET POS. OF CENTERED WHOLE REST
09400 TT=0
09500 B=Q(J+2)
09600 C GET THE STAFF NUM.
09700 DO 602 M=1,L
09800 T=CODEN(KPN,M,Q,JJ)
09900 A=Q(JJ+3)
10000 C GET POS. OF ITEM
10100 IF(A.GT.RS)GO TO 602
10200 C JUMP IF ITEM IS TO RIGHT OF REST
10300 IF(T.NE.4)GO TO 602
10400 C IS THE ITEM A BAR LINE
10500 IF(A.GT.TT)TT=A
10600 C FINDS BAR LINE CLOSEST TO LEFT OF REST
10700 602 CONTINUE
10800 C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
10900 T=20000
11000 A=20000
11100 C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
11200 DO 613 M=1,L
11300 IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
11400 IF(Q(JJ).LT.7)GO TO 609
11500 C SKIP IF RHYTH NOT IN P9
11600 IF(Q(JJ+9).LT..05)GO TO 613
11700 C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
11800 609 B=Q(JJ+3)
11900 C POS. OF ITEM
12000 X=B-TT
12100 IF(X)GO TO 613
12200 C JUMP IF ITEM IS TOO FAR TO LEFT
12300 IF(X.GT.A)GO TO 613
12400 A=X
12500 T=B
12600 C T = POS OF NOTE OR REST NEAREST BAR, ETC.
12700 613 CONTINUE
12800 IF(T.NE.20000)GO TO 612
12900 C JUMP IF NOTE OR REST FOUND
13000 JCEN=-1
13100 GO TO 1801
13200 612 Q(J+3)=T
13300 C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
13400 C MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
13500 C THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
13600 1801 IF(R.LT.4)GO TO 702
13700 IF(R.EQ.17)GO TO 1702
13800 IF(R.EQ.18)GO TO 1702
13900 IF(R.LE.7)GO TO 30
14000 IF(R.NE.44)GO TO 601
14100 IF(RZ.EQ.2)GO TO 601
14200 C RZ=2= BAR LINE ON UPPER STAFF
14300 IF(Q(J+6).EQ.0)GO TO 601
14400 IF(Q(J+5).EQ.0)GO TO 601
14500 C GETS LEFT END OF LINES, CRESC., DASHES.
14600 GO TO 604
14700 30 IF(R.NE.7)GO TO 605
14800 IF(RZ.LT.5)GO TO 604
14900 C JUMP FOR STANDARD TRILL
15000 RS=Q(J+7)
15100 IF(RS.EQ.1)GO TO 604
15200 IF(ABS(RS).GE.3)GO TO 604
15300 C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
15400 GO TO 601
15500 605 IF(R.NE.4)GO TO 604
15600 IF(RZ.LE.3)GO TO 702
15700 C JUMP IF IT IS A BAR LINE
15800 CC IF(RZ.LT.4)GO TO 601
15900 IF(Q(J+6).NE.0)GO TO 604
16000 C GO GET OTHER POS OF LINE
16100 GO TO 601
16200 1702 IF(Q(J+4).NE.0)GO TO 601
16300 IF(Q(J+2).NE.0)GO TO 601
16400 C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
16500 702 NN(N)=R
16600 GO TO 601
16700 C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
16800 604 CALL MMNN(6)
16900 C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS
17000 IF(R.NE.6)GO TO 601
17100 C NEXT FOR BEAMS
17200 IF(RZ.LT.8)GO TO 608
17300 IF(Q(J+10).EQ.0)GO TO 608
17400 IF(Q(J+8))GO TO 608
17500 C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
17600 IF(Q(J+7).GT.0)CALL MMNN(8)
17700 C NEXT SHIFTS P8 OF COMPOSITE BEAMS
17800 608 IF(RZ.LT.7)GO TO 601
17900 IF(Q(J+7))GO TO 688
18000 C P7 IS NEG FOR TREMOLO
18100 IF(Q(J+8).EQ.0)GO TO 601
18200 C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
18300 688 IF(Q(J+9).GT.0)CALL MMNN(9)
18400 C FOUND A POS. IN P9
18500 601 CONTINUE
18600 KPG=TTT+1
18700 C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)
18800
18900 C NEXT SORTS THE POINTS
19000 6000 J=1
19100 610 IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
19200 CALL EXCHG(MM(J),NN(J))
19300 C ABOVE EXCHGS --(J) AND --(J+1)
19400 IF(J.EQ.1)GO TO 710
19500 J=J-1
19600 GO TO 610
19700 710 J=J+1
19800 IF(J.LT.N)GO TO 610
19900 C NOW ALL SORTED
20000 CALL FNDEND(R)
20100 CALL SHFTQ(R)
20200 C SHIFTS TO PROPER HORIZ. POS.
20300 IF(IPG)CALL RESTP
20400 C RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS.
20500 IF(N.LE.0)GO TO 122
20600 C N IS NEG IF ONLY RESTS ON THIS LINE. GO BACK.
20700
20800 DO 119 K=1,150
20900 119 HH(K)=0
21000 C HH ARRAY WILL HOLD FINAL COMPOSITE.
21100 G(1)=0
21200 E(1)=0
21300 F(1)=0
21400 RN(1500)=0
21500 RN(2500)=0
21600 ST=0
21700 C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
21800 C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
21900 KE=0
22000 J=1000
22100 933 JJ=1500
22200 JJJ=2000
22300 T=0
22400 M=0
22500 A=0
22600 B=0
22700
22800 DO 33 K=1,N
22900 IF(NORH(KK))GO TO 33
23000 CC KK=NN(K)
23100 CC IF(KK.EQ.0)GO TO 33
23200 CC IF(KK.EQ.4)GO TO 2133
23300 CC IF(KK.EQ.17)GO TO 2133
23400 C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
23500 CC IF(KK.EQ.18)GO TO 2133
23600 CC IF(KK.GT.2)GO TO 33
23700 2133 LL=MM(K)-3
23800 IF(KK.LE.2)GO TO 1133
23900 RH=.01
24000 C RHYTHMIC VALUE OF BARLINE, METER, KSIG
24100 CCC IF(KK.NE.4)RH=.6
24200 GO TO 3133
24300 1133 IF(Q(LL+2).NE.ST)GO TO 33
24400 C JUMP IF NOT ON RIGHT STAFF
24500 RA=9
24600 IF(KK.EQ.2)RA=7
24700 IF(Q(LL).LT.RA-2)GO TO 33
24800 C JUMP IF WDCNT IS TOO SHORT
24900 IF(KK.EQ.1)GO TO 433
25000 IF(Q(LL).LT.6)GO TO 433
25100 C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
25200 RZ=Q(LL+8)
25300 C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
25400 IF(RZ.LE.0)GO TO 433
25500 Q(LL+7)=3
25600 C 3 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST
25700 IF(RZ.LT.8)GO TO 433
25800 Q(LL+5)=-3
25900 C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
26000 RZ=IFIX(RZ/2.0)+1.0
26100 IF(RZ.GT.6)RZ=6
26200 C LIMIT OF 8 ON RHYTH VAL.
26300 Q(LL+7)=RZ
26400 433 RH=Q(LL+IFIX(RA))
26500 IF(RH.EQ.0)GO TO 33
26600 3133 RZ=Q(LL+3)
26700 IF(ZERO(RZ,A).EQ.0)GO TO 133
26800 C JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
26900 RRH=RH
27000 C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
27100 TT=T
27200 C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
27300 J=J+1
27400 C UPDATE COUNTER IN POSITION ARRAY
27500 T=T+RH
27600 C ADD TO TOTAL RHYTHM
27700 RN(J)=T
27800 A=Q(LL+3)
27900 C SAVE POS. OF THIS NOTE.
28000 GO TO 33
28100 133 IF(RH.EQ.RHH)GO TO 33
28200 C IGNORE 2ND RHYTH IF SAME AS FIRST
28300 IF(ZERO(RZ,B).EQ.0)GO TO 333
28400 C JUMP IF A THIRD DIFFERENT RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
28500 TTT=TT
28600 C SAVE TOTAL RHYTHM TO THIS POINT.
28700 TT=TT+RH
28800 JJ=JJ+1
28900 C UPDATE COUNTER FOR 2ND ARRAY
29000 RN(JJ)=TT
29100 RRRH=RH
29200 B=A
29300 GO TO 33
29400 333 IF(RH.EQ.RRRH)GO TO 33
29500 TTT=TTT+RH
29600 JJJ=JJJ+1
29700 RN(JJJ)=TTT
29800 33 CONTINUE
29900 C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
30000 IF(ST.NE.0)GO TO 733
30100 KE=J-999
30200 C TOTAL NUM OF RHYTHMS ON STAFF1.
30300 CC IF(JPG.EQ.0)GO TO 2233
30400 IF(KPG.LE.1)GO TO 2233
30500 C KPG=0=PARTS; =1=PAGE, 1 STAFF
30600 C JUMP IF ONLY ONE STAFF
30700 C****733 KF=J-2499
30800 C KF=NUM OF RHYTHMS ON NEXT STAFF. **** NEVER USED ****
30900 733 ST=ST+1
31000 IF(ST.GT.1)GO TO 833
31100 C JUMP IF ALL STAVES HAVE BEEN READ.
31200 1233 J=2500
31300 GO TO 933
31400 833 IF(J.NE.2500)GO TO 1533
31500 C JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
31600 C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)
31700
31800 2233 CALL RLOOP(HH,E,KE)
31900 C FOR SINGLE STAFF OF RHYTHM
32000 KL=KE
32100 GO TO 1333
32200 1533 K=1
32300 L=1
32400 M=0
32500 19 KK=K
32600 LL=L
32700 1 SM=10000
32800 K=K+1
32900 IF(K.GT.KE)GO TO 10
33000 4 L=L+1
33100 Y=F(L)
33200 B=Y-F(L-1)
33300 IF(B.LT.SM)SM=B
33400 2 X=E(K)
33500 A=X-E(K-1)
33600 C A AND B HAVE TRUE DURATIONS NOW
33700 IF(A.LT.SM)SM=A
33800 C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
33900 IF(ZERO(X,Y).EQ.0)GO TO 3
34000 C JUMP IF EQUAL RHYTHS
34100 IF(X.GT.Y)GO TO 4
34200 K=K+1
34300 C STEP FORWARD UNTIL X IS .GT. Y
34400 GO TO 2
34500 3 IF(K.NE.KK+1)GO TO 13
34600 IF(L.NE.LL+1)GO TO 14
34700 M=M+1
34800 G(M)=E(KK)
34900 GO TO 19
35000 13 IF(L.NE.LL+1)GO TO 15
35100 DO 16 J=KK,K-1
35200 M=M+1
35300 16 G(M)=E(J)
35400 GO TO 19
35500 14 DO 17 J=LL,L-1
35600 M=M+1
35700 17 G(M)=F(J)
35800 GO TO 19
35900 15 XM=SM-.001
36000 M=M+1
36100 P=E(KK)
36200 G(M)=P
36300 7 KK=KK+1
36400 LL=LL+1
36500 YM=SM*1.5
36600 C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
36700 S=P
36800 T=P
36900 27 A=E(KK)
37000 B=F(LL)
37100 IF(ZERO(A,B).EQ.0)GO TO 19
37200 X=ZERO(A,P)
37300 Y=ZERO(B,P)
37400 C FUNCT. ZERO: ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
37500 S=E(KK-1)
37600 T=F(LL-1)
37700 9 IF(A-S.LT.X-.01)X=ZERO(A,S)
37800 IF(B-T.LT.Y-.01)Y=ZERO(B,T)
37900 IF(A.GT.B+.01)GO TO 8
38000 B=A
38100 KK=KK+1
38200 62 IF(X.GT.YM)GO TO 5
38300 IF(X.EQ.0)GO TO 27
38400 P=P+SM
38500 25 M=M+1
38600 G(M)=P
38700 GO TO 27
38800 5 P=P+SM
38900 IF(P)GO TO 203
39000 C IF(P)ERROR
39100 IF(P.LT.B-.01)GO TO 5
39200 GO TO 25
39300 8 X=Y
39400 LL=LL+1
39500 GO TO 62
39600 10 M=M+1
39700 G(M)=E(KE)
39800 CC TYPE 410,(E(K),K=1,KE)
39900 CC TYPE 410,(F(K),K=1,KF)
40000 CC TYPE 410,(G(K),K=1,M)
40100 CBCB WRITE(21,410)(E(K),K=1,KE)
40200 CB WRITE(21,410)(F(K),K=1,KF)
40300 CB WRITE(21,410)(G(K),K=1,M)
40400 410 FORMAT(10F7.2)
40500 C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
40600 1033 JJ=1
40700 H(1)=0
40800 J=1
40900 K=2
41000 L=2
41100 511 IF(J.EQ.M)GO TO 911
41200 J=J+1
41300 X=G(J)
41400 1211 A=E(K)
41500 B=F(L)
41600 Y=ZERO(X,A)
41700 Z=ZERO(X,B)
41800 IF(A-B.GT..01)GO TO 1111
41900 IF(Y.EQ.0)GO TO 1311
42000 IF(X.LT.A-.01)GO TO 1111
42100 K=K+1
42200 1411 JJ=JJ+1
42300 H(JJ)=-A
42400 GO TO 1211
42500 1111 IF(Z.EQ.0)GO TO 1311
42600 IF(X.LT.B-.01)GO TO 1311
42700 L=L+1
42800 A=B
42900 GO TO 1411
43000
43100 1311 JJ=JJ+1
43200 H(JJ)=X
43300 IF(Y.EQ.0)GO TO 611
43400 IF(Z.EQ.0)GO TO 711
43500 IF(ZERO(A,B).EQ.0)GO TO 511
43600 P=A
43700 IF(P.GT.B+.01)GO TO 811
43800 IF(P.GT.X+.01)GO TO 511
43900 K=K+1
44000 GO TO 1011
44100 811 P=B
44200 IF(P.GT.X+.01)GO TO 511
44300 L=L+1
44400 1011 JJ=JJ+1
44500 H(JJ)=-P
44600 C NON-SPACED RHYTHS ARE NEG.
44700 GO TO 511
44800 611 K=K+1
44900 IF(Z.GT.0)GO TO 511
45000 711 L=L+1
45100 GO TO 511
45200 911 IF(HH(2).EQ.0)GO TO 2011
45300 K=2
45400 J=2
45500 L=1
45600 HHH(1)=0
45700 1511 IF(J.GT.JJ)GO TO 1811
45800 P=H(J)
45900 A=ABS(P)
46000 B=ABS(HH(K))
46100 IF(ZERO(B,A).EQ.0)GO TO 1611
46200 IF(A.GT.B)GO TO 1711
46300 J=J+1
46400 GO TO 1911
46500 1711 P=HH(K)
46600 GO TO 2211
46700 1611 J=J+1
46800 2211 K=K+1
46900 1911 L=L+1
47000 HHH(L)=P
47100 GO TO 1511
47200 2011 CALL RLOOP(HH,H,JJ)
47300 KL=JJ
47400 GO TO 2111
47500 1811 CALL RLOOP(HH,HHH,L)
47600 KL=L
47700 2111 IF(ST.GE.KPG)GO TO 1333
47800 CALL RLOOP(E,G,M)
47900 KE=M
48000 C GO WAY BACK AND READ ANOTHER LINE.
48100 GO TO 1233
48200 1333 E(1)=0
48300 GO TO 2333
48400 TYPE 410,(HH(K),K=1,KL)
48500 WRITE(21,410)(HH(K),K=1,KL)
48600 2333 JD=1
48700 C JD IS COUNTER FOR DUMMY POSITIONS.
48800 DUMMY(1)=1
48900 ST=0
49000 183 B=0
49100 LL=2
49200
49300 DO 181 K=1,N
49400 IF(NORH(L))GO TO 181
49500 C LOOK FOR DUMMY RHYTHMS.
49600 IF(L.LE.2)GO TO 2184
49700 RZ=.01
49800 C RHYTHMIC VALUE OF BAR, METER, KSIG. CHANGED TO ABS. SIZE LATER.
49900 GO TO 1184
50000 2184 LF=MM(K)
50100 IF(Q(LF-1).NE.ST)GO TO 181
50200 C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
50300 J=6
50400 IF(L.EQ.2)J=4
50500 RZ=Q(LF+J)
50600 1184 B=B+RZ
50700 184 V=ABS(HH(LL))
50800 IF(ZERO(B,V).GT.0)GO TO 182
50900 C FOUND RHYTH MATCH
51000 JD=JD+1
51100 DUMMY(JD)=LL
51200 LL=LL+1
51300 GO TO 181
51400 182 IF(B.LT.V-.01)GO TO 181
51500 LL=LL+1
51600 GO TO 184
51700 181 CONTINUE
51800 ST=ST+1
51900 IF(ST.LT.KPG)GO TO 183
52000
52100 C NEXT SORT DUMMY ARRAY
52200 J=0
52300 185 DO 186 K=2,JD
52400 IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
52500 DO 188 LL=K,JD
52600 188 DUMMY(LL-1)=DUMMY(LL)
52700 JD=JD-1
52800 GO TO 185
52900 187 IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
53000 CALL EXCH(DUMMY(K),DUMMY(K-1))
53100 GO TO 185
53200 186 CONTINUE
53300 C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
53400 PX=0
53500 LF=0
53600 K=1
53700 V=0
53800
53900 81 K=K+1
54000 IF(K.GT.KL)GO TO 1433
54100 B=HH(K)
54200 A=B-V
54300 V=B
54400 IF(V)GO TO 82
54500 85 W=V
54600 IF(A.GT.0.01)GO TO 89
54700 C .GT. BECAUSE OF ROUND-OFF ERROR
54800 T=5
54900 IF(HH(K+1)-V.LE..01)T=2
55000 PX=PX+T
55100 C THIS FOR BARS, KSIG, METER
55200 GO TO 189
55300 89 PX=PX+14.0*EXP(ALOG(A)*0.5849624)
55400 C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5)) NOT FIBBONACI (1.618)
55500 CC89 PX=PX+PFIBX(A)
55600 189 E(K)=PX
55700 IF(LF.NE.0)GO TO 86
55800 GO TO 81
55900 82 LF=K
56000 83 K=K+1
56100 V=HH(K)
56200 IF(V)GO TO 83
56300 A=V-W
56400 GO TO 85
56500 86 LL=LF-1
56600 D=E(K)-E(LL)
56700 87 S=-HH(LF)-HH(LL)
56800 T=HH(K)-HH(LL)
56900 T=S/T
57000 C THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
57100 E(LF)=E(LL)+D*T
57200 LF=LF+1
57300 IF(LF.NE.K)GO TO 87
57400 LF=0
57500 GO TO 81
57600
57700 1433 GO TO 2433
57800 TYPE 410,(E(K),K=1,KL)
57900 WRITE(21,410)(E(K),K=1,KL)
58000 C 5 IS SPACE AFTER 1ST BARLINE
58100 2433 R8=RNEXT
58200 C POS OF 1ST BAR = END OF PREV. LINE
58300 IF(ENDLN.EQ.0)RNEXT=9
58400 C MAKES ROOM FOR 1ST CLEF.
58500 KL=KL-1
58600 J=0
58700 R5=0
58800 KK=1
58900 JD=1
59000 W=0
59100 LF=0
59200
59300 DO 80 K=1,N
59400 IF(NORH(L))GO TO 80
59500 A=Q(MM(K))
59600 IF(ZERO(A,W).EQ.0)GO TO 80
59700 C SKIP IF SAME POS OF NOTE OR REST.
59800 W=A
59900 R7=R8
60000 190 J=J+1
60100 IF(J.LE.KL)GO TO 290
60200 203 FORMAT(' FOUND CENTERED WHOLE REST!')
60300 LL=0
60400 IF(JCEN.GE.0)GO TO 120
60500 TYPE 203
60600 GO TO 121
60700 120 W=LL
60800 A=0
60900 DO 124 K=1,N
61000 LF=NN(K)
61100 IF(LF.GT.2)GO TO 124
61200 IF(LF.EQ.0)GO TO 124
61300 KE=MM(K)
61400 IF(Q(KE-1).NE.W)GO TO 124
61500 C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
61600 JD=6
61700 IF(LF.EQ.2)JD=4
61800 A=A+Q(KE+JD)
61900 124 CONTINUE
62000 TYPE 123,LL,A
62100 LL=LL+1
62200 IF(LL.LT.KPG)GO TO 120
62300 123 FORMAT(' STF',I2,' =',F9.5,' QTRS')
62400 121 PAUSE' *****RHYTHM MISMATCH OR MISALIGNED NOTES*****'
62500 GO TO 90
62600 290 IF(DUMMY(JD).NE.J)GO TO 190
62700 JD=JD+1
62800 90 R8=RNEXT+E(J)
62900 R4=R5
63000 R5=A
63100 X=(R8-R7)/(R5-R4)
63200 S=R7-R4*X
63300 DO 91 L=KK,K
63400 LL=MM(L)
63500 91 Q(LL)=S+X*Q(LL)
63600 KK=K+1
63700 80 CONTINUE
63800
63900 IF(KK.GT.K)GO TO 180
64000 C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
64100 R7=Q(LL)-R5
64200 C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
64300 DO 280 L=KK,K
64400 LL=MM(L)
64500 280 Q(LL)=R7+Q(LL)
64600 180 JJ=JJ2-2
64700 L=JJ2
64800 M=0
64900 C FLAG FOR REST AT START OF LINE
65000
65100 JJJ=-1
65200 C FLAG FOR 1ST BAR OF LINE 12/77
65300 V=0
65400 ACCI=0
65500 DO 12 J=1,JJ
65600 R=CODEN(KPN,J,Q,LA)
65700 CC IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
65800 IF(R.EQ.4)GO TO 680
65900 IF(M)GO TO 780
66000 IF(R.NE.2)GO TO 780
66100 IF(KBR.EQ.0)GO TO 12
66200 C LOOK FOR RESTS AT FRONT OF LINE.
66300 X=0
66400 CALL TURN(J,JJ,1,X)
66500 PGTRN(KBR)=PGTRN(KBR)+X
66600 M=-1
66700 780 IF(R.NE.1)GO TO 12
66800 IF(V.NE.Q(LA+3))GO TO 782
66900 IF(JACC)GO TO 781
67000 782 IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
67100 JACC=-1
67200 ACCI=ACCI+.5
67300 V=Q(LA+3)
67400 781 M=-1
67500 IF(NOGRCE)GO TO 12
67600 C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
67700 C FOUND A NOTE
67800 IF(Q(LA+9).GT.0.05)GO TO 12
67900 C JUMP IF NOT A GRACE NOTE
68000 R=Q(LA+2)
68100 C THE STAFF NUM.
68200 DO 580 LF=J+1,JJ
68300 IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
68400 IF(Q(JD+2).NE.R)GO TO 580
68500 IF(Q(JD).LT.7)GO TO 580
68600 IF(Q(JD+9).EQ.0)GO TO 580
68700 C CHORD NOTE
68800 R4=Q(LA+3)
68900 CC R4=Q(LA+3)-1
69000 R5=Q(JD+3)
69100 C THE STAFF # IS IN R2
69200 R8=RSTFAC(IFIX(R2+1))+.5
69300 IF(Q(JD+4).LT.80)R8=R8*2
69400 C INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
69500 R8=R5-R8
69600 CC R8=R5-R8-1
69700 CCC IF(R4.EQ.R5)GO TO 12
69800 IF(R4.NE.R5)GO TO 480
69900 C GRACE NOTE AT START OF LINE ***** FIX THIS????
70000 DO 880 KE=1,LF-1
70100 880 Q(KPN(KE)+3)=R8
70200 C MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
70300 GO TO 12
70400 480 R2=Q(LA+2)
70500 R9=R5
70600 CALL PTMOVE(Q,KPN)
70700 CC TYPE 9999,Q(J+3),Q(JD+3)
70800 CC9999 FORMAT(2F)
70900 GO TO 12
71000 580 CONTINUE
71100 GO TO 12
71200 C ABOVE FOR GRACE NOTE SPACING.
71300 680 KBR=KBR+1
71400 C BAR LINE COUNTER
71500 T=Q(LA+3)
71600 C TOTAL SPACE
71700 X=0
71800 CALL TURN(J-1,1,-1,X)
71900 CALL TURN(J+1,JJ,1,X)
72000 222 PGTRN(KBR)=X
72100 C FINDS PAGE-TURN POSSIBILITIES
72200 C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
72300 IF(JJJ)RNEXT=RNEXT-6
72400 C JJJ=-1 IF 1ST BAR OF LINE. 12/77
72500 JJJ=0
72600 BARS(KBR)=(T-RNEXT+ACCI)*BFAC
72700 C SIZE OF THIS MEASURE + .5*ACCIDENTALS
72800 ACCI=0
72900 K=J
73000 RNEXT=T
73100 12 CONTINUE
73200
73300 IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
73400 RNEXT=RNEXT+3
73500 JJ2=L
73600 C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
73700 CC???380 LCNT=0
73800 CC??? NDPY=0
73900 C JJ2 IS END OF PNTR DATA
74000 JPQ=KPN(JJ2-1)+1
74100 CALL PUTEXT(NMPG,'PAG')
74200 CALL EXTOUT(RSTFAC,128)
74300 CALL EXTOUT(PN,JJ2)
74400 CALL EXTOUT(Q,JPQ)
74500 CALL FINEXT
74600
74700 LASTNM=NMPG
74800 NMPG=NMPG+2
74900 IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
75000 C WILL GO FROM PAGEA TO PAGFZ, ETC. (104) ADD TO THIS IF NEEDED.
75100 IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
75200 IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
75300 122 ENDLN=RNEXT
75400 END